home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Panorama / Panorama - Disk 29B (1988-05-11)(Pacific North-West Amigas Club)[WB].zip / Panorama - Disk 29B (1988-05-11)(Pacific North-West Amigas Club)[WB].adf / BOARD.GAMES / chain reaction (.txt) < prev    next >
AmigaBASIC Source Code  |  1987-08-15  |  7KB  |  194 lines
  1. PRINT  "Select square using arrow keys..."
  2. PRINT  " Place bombs with the space bar."
  3. PRINT  "  When critical mass for a given"
  4. PRINT  "   square is reached, the chain  "
  5. PRINT  "    reaction will commence."
  6. FOR i=1 TO 10000:NEXT i
  7.  
  8. DEFINT a-z:DEFSNG r,g,b
  9. SCREEN 1,320,200,3,1:WINDOW 3,"",(0,0)-(311,186),16,1:WINDOW OUTPUT 3:COLOR 3,0
  10. DIM s(42,1),u(4,5),p(4,5),j(4,5),bx(4,5),by(4,5),n(1,5),er(528),w1(255),w2(255),rt(30),tr(30),tx(30),ty(30)
  11. FOR i=0 TO 255 : w1(i)=RND*255-128:w2(i)=RND*255-128:NEXT
  12. RESTORE palettedata:FOR i = 0 TO 7:READ r,g,b:PALETTE i,r,g,b:NEXT
  13. palettedata:
  14. DATA 0,0,.7,0,0,0,.8,.8,0,.7,.7,.7,.33,.87,0,.9,.9,.9,.6,0,0,0,.6,0
  15. WIDTH 40:CLS:RANDOMIZE TIMER
  16. GOSUB initshapes:e=0
  17. FOR i=1 TO 3: FOR j=1 TO 4:j(i,j)=4:NEXT:j(i,0)=3:j(i,5)=3:NEXT
  18. RESTORE corners: FOR j=1 TO 4:j(0,j)=3:j(4,j)=3:READ a,b:j(a,b)=2:NEXT
  19. corners:DATA 0,0,0,5,4,0,4,5
  20. RESTORE Bombpos:FOR i=1 TO 4:FOR j=1 TO i:READ bx(i,j),by(i,j):NEXT j,i
  21. bx(4,5)=bx(4,4):by(4,5)=by(4,4)
  22. Bombpos: DATA 13,9,6,9,20,9,13,5,4,15,22,15,13,3,13,17,4,9,22,9
  23. LOCATE 8,14:PRINT  "CHAIN REACTION"
  24. LOCATE 12,9:PRINT  "Number of players(1/2)?";
  25. WHILE np<>1 AND np<>2:np=VAL(INKEY$):WEND
  26. IF np<>2 THEN
  27.   LOCATE 16,10:PRINT "Computer first (Y/N)?";
  28.   WHILE k$ <>"Y" AND k$<>"N":k$=UCASE$ (INKEY$):WEND
  29.   tu=ABS(k$="Y")
  30.   END IF
  31. CLS:COLOR 3,1:LOCATE 1,13:PRINT " CHAIN REACTION  "
  32. GOSUB drawgrid
  33.  
  34. MainLoop:
  35. WHILE e=0:tu=-tu+1:co=tu+6
  36. IF np=1 AND tu=0 THEN
  37.   GOSUB computer
  38.   ELSE
  39.   GOSUB human
  40.   WHILE p(y,x)<>tu+1 AND p(y,x):GOSUB human:WEND
  41.   END IF
  42. u(y,x)=u(y,x)+1:fs(tu)=fs(tu)+1:IF p(y,x)=0 THEN p(y,x)=tu+1
  43. GOSUB placebomb
  44. IF u(y,x)=j(y,x) THEN
  45. checkgrid:e=0:fg=0:FOR p=0 TO 4:FOR q=0 TO 5:y=p:x=q
  46. IF u(y,x)>=j(y,x) AND e=0 THEN fg=1:GOSUB fullsquare
  47. NEXT q,p:IF fg=1 AND e=0 THEN checkgrid
  48. END IF
  49. WEND
  50.  
  51. endgame:
  52. COLOR 3,1:LOCATE 24,15:PRINT " GAME OVER ";:FOR i=1 TO 10000:NEXT
  53. LOCATE 24,5:PRINT " Press space bar to play again. ";
  54. k$="":WHILE k$<>" ":k$=INKEY$:WEND
  55. SCREEN CLOSE 3:WINDOW CLOSE 3: RUN
  56.  
  57. human:
  58. WHILE INKEY$<>"":WEND:x=hx(tu):y=hy(tu):dx=0:dy=0:GOSUB drawcursor:k$=""
  59. WHILE k$<>" ":k$=INKEY$
  60. IF k$=CHR$(28) THEN IF y>0 THEN dy=-1
  61. IF k$=CHR$(29) THEN IF y<4 THEN dy=1
  62. IF k$=CHR$(31) THEN IF x>0 THEN dx=-1
  63. IF k$=CHR$(30) THEN IF x<5 THEN dx=1
  64. IF dx<>0 OR dy<>0 THEN
  65.   co=0:GOSUB drawcursor
  66.   x=x+dx:y=y+dy:co=tu+6:GOSUB drawcursor
  67.   dx=0:dy=0
  68.   END IF
  69. WEND:hx(tu)=x:hy(tu)=y
  70. co=0:GOSUB drawcursor:co=tu+6:RETURN
  71.  
  72. fullsquare:
  73. r=0:yy=32*y+15:xx=36*x+50:WAVE 0,w1:WAVE 1,w2
  74. FOR i=1 TO 4:PUT(xx+2,yy+2),er,PSET
  75. FOR j=1 TO 4:n(1,j)=INT(RND*3)-1:NEXT
  76. r=-r+1:k=u(y,x)+1:bn=co-6:IF k=6 THEN k=5
  77. ON k GOSUB b0,b1,b2,b3,b4,b4,
  78. FOR m=255 TO 10 STEP -20:SOUND 100,0.1,m,0 
  79. SOUND 100,0.1,m,3:FOR n=1 TO RND*20:NEXT n,m:NEXT
  80. tx=x:ty=y:j1=0:k1=k-1:y1=32*y+15+by(1,1):x1=36*x+50+bx(1,1)
  81. IF tx>0 THEN x=tx-1:dx=-1:dy=0:GOSUB explodebombs:GOSUB addbomb
  82. IF tx<5 THEN x=tx+1:dx=1:dy=0:GOSUB explodebombs:GOSUB addbomb
  83. x=tx:IF ty>0 THEN y=ty-1:dy=-1:dx=0:GOSUB explodebombs:GOSUB addbomb
  84. IF ty<4 THEN y=ty+1:dy=1:dx=0:GOSUB explodebombs: GOSUB addbomb
  85. IF fs(0)<1 OR fs(1)<1 THEN e=1
  86. y=ty:u(y,x)=u(y,x)-j(y,x):GOSUB placebomb:IF u(y,x)=0 THEN p(y,x)=0
  87. RETURN
  88.  
  89. addbomb:
  90. IF p(y,x)<>tu+1 THEN fs(tu)=fs(tu)+u(y,x):fs(-tu+1)=fs(-tu+1)-u(y,x)
  91. p(y,x)=tu+1:u(y,x)=u(y,x)+1:GOSUB placebomb:RETURN
  92.  
  93. drawgrid:
  94. FOR y=0 TO 4:yy=32*y+16:FOR x=0 TO 5:xx=36*x+51
  95. LINE(xx,yy)-(xx+34,yy+30),2,b
  96. NEXT x,y
  97. GET(xx+1,yy+1)-(xx+33,yy+29),er:
  98. RETURN
  99.  
  100. drawcursor:
  101. yy=32*y+15:xx=36*x+50
  102. LINE(xx,yy)-(xx+36,yy+32),co,b
  103. LINE(xx+2,yy+2)-(xx+34,yy+30),co,b
  104. RETURN
  105.  
  106. placebomb:
  107. yy=32*y+15:xx=36*x+50:r=0:bn=co-6
  108. PUT(xx+2,yy+2),er,PSET:k=u(y,x)+1:IF k=6 THEN k=5
  109. ON k GOTO b0,b1,b2,b3,b4,b4
  110. b0:RETURN
  111. b1:PUT(xx+bx(1,k-1),yy+by(1,k-1)),s(0,bn):RETURN
  112. b2:FOR j=1 TO k-1:PUT(xx+bx(2,j)+n(r,j),yy+by(2,j)+n(r,j)),s(0,bn):NEXT:RETURN
  113. b3:FOR j=1 TO k-1:PUT(xx+bx(3,j)+n(r,j),yy+by(3,j)+n(r,j)),s(0,bn):NEXT:RETURN
  114. b4:FOR j=1 TO k-1:PUT(xx+bx(4,j)+n(r,j),yy+by(4,j)+n(r,j)),s(0,bn):NEXT:RETURN
  115.  
  116. checkneighbour:
  117. fp=1:IF y>0 THEN IF p(y-1,x)=2 THEN ay=y-1:RETURN
  118. IF x>0 THEN IF p(y,x-1)=2 THEN ax=x-1:RETURN
  119. IF x<5 THEN IF p(y,x+1)=2 THEN ax=x+1:RETURN
  120. IF y<4 THEN IF p(y+1,x)=2 THEN ay=y+1:RETURN
  121. fp=0:RETURN
  122.  
  123. computer:
  124. xt=0:FOR y=0 TO 4:FOR x=0 TO 5
  125. IF p(y,x)<>2 THEN xt=xt+1:ty(xt)=y:tx(xt)=x
  126. NEXT x,y
  127. LOCATE 24,15:COLOR 3,0:PRINT "thinks...hmm";
  128. FOR i=1 TO xt:rt(i)=0:tr(i)=0:y=ty(i):x=tx(i):GOSUB checkneighbour
  129. IF fg=1 AND fp AND u(y,x)>0 THEN endcomputer
  130. IF u(y,x)+1=j(y,x) THEN
  131.   IF fp=1 AND u(ay,ax)+1=j(ay,ax) THEN rt(i)=6:GOTO checknext
  132.   IF fp=1 THEN rt(i)=2:GOTO checknext
  133.   IF fp=0 THEN rt(i)=1:GOTO checknext
  134.   END IF
  135. IF j(y,x)=2 THEN
  136.   IF fp=0 AND u(y,x)=1 THEN rt(i)=1:GOTO checknext
  137.   IF fp=0 AND u(y,x)=0 THEN rt(i)=4:GOTO checknext
  138.   IF fp=1 AND u(y,x)=1 THEN rt(i)=4:GOTO checknext
  139.   END IF
  140. IF u(ay,ax)+1=j(ay,ax) THEN rt(i)=1:GOTO checknext
  141. IF u(y,x)+2>=j(y,x) THEN
  142.   IF fp=1 AND u(ay,ax)+1<j(ay,ax) THEN rt(i)=5:GOTO checknext
  143.   IF fp=0 THEN rt(i)=3:GOTO checknext
  144.   rt(i)=2:GOTO checknext
  145.   END IF
  146. IF fp=0 THEN rt(i)=2:GOTO checknext
  147. rt(i)=1
  148.  
  149. checknext:    
  150. NEXT:zt=0:ab=6
  151. WHILE zt=0
  152. FOR i=1 TO xt: IF rt(i)=ab THEN zt=zt+1:tr(zt)=i
  153. NEXT:ab=ab-1
  154. WEND
  155. dh=INT(zt*RND)+1:hd=tr(dh):y=ty(hd):x=tx(hd)
  156.  
  157. endcomputer:
  158. LOCATE 24,15:PRINT "            ";:fg=fg+1:RETURN
  159.  
  160. explodebombs:
  161. j1=j1+1:xx=x1-bx(1,1):yy=y1-by(1,1):s=1087:bn=co-6
  162. WAVE 0,SIN:SOUND 660,0.5,255
  163. FOR j=1 TO 500:NEXT:SOUND 0,0,0
  164. PUT (xx+bx(k1,j1)+n(r,j1),yy+by(k1,j1)+n(r,j1)),s(0,bn)
  165. IF dy=0 THEN
  166.   x2=x1+35*dx:dx=dx*4:PUT(x1,y1),s(0,bn)
  167.   FOR i=x1 TO x2 STEP dx:s=s-40:SOUND s,1,50
  168.   PUT (i,y1),s(0,bn):PUT(i+dx,y1),s(0,bn):NEXT
  169.   PUT (xx+3,yy+3),er
  170.    ELSE
  171.   y2=y1+31*dy:dy=dy*4:PUT(x1,y1),s(0,bn)
  172.   FOR i=y1 TO y2 STEP dy:s=s-40:SOUND s,1,50
  173.   PUT (x1,i),s(0,bn):PUT(x1,i+dy),s(0,bn):NEXT
  174.   PUT(xx+3,yy+3),er
  175.   END IF
  176. RETURN
  177.  
  178. initshapes:
  179. RESTORE redbomb
  180. FOR j=0 TO 1:FOR i=0 TO 42 
  181. READ a$:s(i,j)=VAL("&H" +a$):NEXT i,j:RETURN
  182.  
  183. redbomb:
  184. DATA B,D,3,200,400,400,0,1800,3000,1B00,A00,400,A00,1B00,0,0
  185. DATA 0,0,0,E00,2780,4FC0,E4E0,F5E0,FBE0,F5E0,64C0,3F80,E00,200,400,400
  186. DATA E00,3F80,7FC0,E4E0,F5E0,FBE0,F5E0,64C0,3F80,E00,3F80
  187.  
  188. greenbomb:
  189. DATA B,D,3,200,400,400,E00,3F80,7FC0,FFE0,FFE0,FFE0,FFE0,7FC0,3F80,E00,
  190. DATA 0,0,0,E00,2780,4FC0,E4E0,F5E0,FBE0,F5E0,64C0,3F80,E00,200,400,400
  191. DATA E00,3F80,7FC0,E4E0,F5E0,FBE0,F5E0,64C0,3F80,E00,3F80
  192.    
  193.  
  194.